00100		TITLE	BUFFER;  DOROTHY BENDER ****** GARPLY *******
00200	
00300	;  ROUTINE TO READ THE OUTPUT FROM THE MUSIC
00400	;  PROGRAM AND CALL THE D-A CONVERTER TO PLAY.
00500	;  
00600	;  THE NAME OF THE FILE TO BE INPUTTED IS 'MUSIC',
00700	;  THE FIRST RECORD OF WHICH CONTAINS THE
00800	;  NUMBER OF WORDS OF DATA IN THE ENTIRE DISK FILE.
00900	
00910		EXTERNAL CORGET,FSINIT
01000	A   ←   1     ;WORK
01100	B   ←   2     ;WORK
01110	P←17
01120	BLOCK←4
01130	SIZE←5
01200	RET ←   3     ;RETURN ACCUMULATOR
01210	PLN←20
01220	PDL: BLOCK PLN
01240	
01300	;;BUFSIZ ←=20224   
01400	↓DSKCHN ←1             ;DISK CHANNEL FOR INPUT
01500	↓ADCHN  ←2             ;D-A CHANNEL FOR OUTPUT
01600	
01700		OPDEF	READCH [51B8]
01800	        OPDEF   MESSAGE[51B8!3B12]
01900	
02000	BEG:	CALLI	0,0         ;RESET I/O DEVICES
02010		MOVE P,[IOWD PLN,PDL]
02020		PUSHJ P,FSINIT
02030		MOVEI SIZE1←=20224
02040		PUSHJ P,CORGET
02050		HALT,
02060		SUBI BLOCK,1
02070		MOVEM BLOCK, LOOP+1
02080	
02090		PUSHJ P,CORGET
02100		HALT,
02110		SUBI BLOCK,1
02120		MOVEM BLOCK, LOOP+4
02130	
02190	 	OPEN 	DSKCHN,[17  ;MODE
02200			'DSK   '    ;DEVICE NAME
02300	 		0]          ;NO BUFFER HEADERS
02400		HALT	BEG         ;RESTART IF DEVICE IS UNAVAILABLE
02500	
02600	 	SETZM	FILBLK+3    ;FOR RESTART
02700	 	SETZM	FILBL2+3    ;FOR RESTART
02800	LX:	MESSAGE [ASCIZ/
02900	  TYPE `P' TO PLAY FROM DISK, `C' TO COPY TAPE TO DISK.
03000	/]
03100		readch a
03200		cain a,"C"
03300		jrst start
03400		caie a,"P"
03500		jrst lx
03600		skipe filblk+3	;is this first time through ?
03700		jrst pla2	;No. Parameters already set up.
03800		;FIND OUT NUMBER OF CHANNELS AND
03900		;THE SPEED.
04000	
04100		MESSAGE	[ASCIZ/HOW MANY CHANNELS?/]
04200		READCH	A
04300		SUBI	A,"0"+1		;CONVERT TO BINR AND ADD 1
04400		DPB	A,[POINT 2,OUTBIT,26]
04500	
04600		MESSAGE [ASCIZ/WHAT IS THE SPEED?/]
04700		READCH  A
04800		SUBI	A,"0"
04900		DPB	A,[POINT 3,OUTBIT,32]
05000	
05100	PLA2:	SETZM FILBLK+3
05200		SETZM FILBL2+3
05300		LOOKUP	DSKCHN,FILBLK
05400		SKIPA			;CAN'T FIND MUSIC.MUS
05500		JRST XOPEN		;FOUND IT
05600		LOOKUP  DSKCHN,FILBL2	;TRY FOR MUSAA.DMD
05700	
05800		JRST	[MESSAGE[ASCIZ/
05900			*** MUSIC FILE NOT FOUND/]
06000			CALLI  12]
06100	        ;EXIT IF FILE IS MISSING
06200		MOVE A,FILBL2+3	;GET LENGTH OF MUSAA.DMD
06300		MOVEM A,FILBLK+3;PUT IT IN RIGHT PLACE
06400	
06500	XOPEN:	OPEN	ADCHN,[117 	;MODE
06600	         	'AD    '        ;DEVICE NAME
06700	 		0]              ;NO BUFFER HEADERS
06800	
06900	  	JRST	[MESSAGE[ASCIZ/
07000			***D-A NOT AVAILABLE/]
07100			CALLI  12]
07200		;EXIT IF D-A IS UNAVAILABLE
07300	
07400	SPWAR:	SPCWAR 17,[CALLI]
07500		MESSAGE [ASCIZ/ GO? /]
07600		READCH A
07700	
07800	
07900	LNTH:	movs a,filblk+3		;get length of file.
08000		movnm a,nwd
08100	
08200	;	-----------------------------------------
08300	
08400		;BEGIN MAIN BODY OF PROGRAM
08500	
08600	LOOP:	JSP	RET,SUB		;ROUTINE TO READ AND WRITE
08700	;;	BUF1-1 			;USE BUF1 FOR THE I/O
08710		0
08800		JUMPLE	B,OUT    	;DONE
08900		
09000		JSP	RET,SUB		;CALL IT AGAIN
09100	;;	BUF2-1			;USE BUF2 FOR THE I/O
09110		0
09200		JUMPG	B,LOOP		;GO BACK FOR MORE IF B>0
09300	
09400	OUT:	close dskchn,		;END OF PROGRAM.
09500		releas adchn,
09600		SPCWAR 0,'SSW'
09700		jrst lx
09800	
09900		;SUBROUTINE TO SET UP IOWD AND READ AND WRITE.
10000		;  1(RET) WILL BE THE RETURN
10100		;  0(RET) WILL BE THE ADDRESS OF THE BUFFER TO BE
10200		;         PUT IN THE RIGHT HALF OF THE IOWD.
10300		;  A      WILL BE A WORK REGISTER
10400	    	;  B      WILL BE TESTED ON THE OUTSIDE.
10500	
10600	SUB:	MOVNI	A,BUFSIZ	;PICK UP AND COMPLEMENT BUFSIZ
10700		ADDB	A,NWD		;A←NWD-BUFSIZ
10800					;NWD←NWD-BUFSIZ
10900		MOVE	B,A		;SAVE B TO BE TESTED FOR LAST
11000					;TIME.
11100		JUMPL	A,LAST		;SET UP FOR LAST TIME.
11200		MOVEI	A,0		
11300	
11400		;THE IOWD LOOKS LIKE:
11500		;  [-BUFSIZ / BUFI-1]
11600	
11700	LAST:	ADDI	A,BUFSIZ
11800		MOVNS	A		;COMPLEMENT A
11900		HRL	A,0(RET)	;PICK UP BUFI AND MOVE IT
12000					;TO THE LEFT SIDE OF A.
12100		MOVSM	A,INLIST	;SWAP A AND MOVE IT.
12200		MOVSM	A,OUTWC		;SAME FOR OUTPUT.
12300		INPUT	DSKCHN,INLIST	;READ A RECORD.
12400		OUTPUT	ADCHN,OUTWC	;WRITE THE RECORD.
12500		JRST	1(RET)		;RETURN
12600	
12700	;	-----------------------------------------
12800	
12900	; STORAGE:
13000	
13100	NWD:	0			;FOR NUMBER OF WORDS OF INPUT.
13200	;;↓BUF1:	BLOCK	BUFSIZ+1	;BUFFER 1
13300	;;BUF2:	BLOCK	BUFSIZ+1	;BUFFER 2
13400	
13500	FILBLK: 'MUSIC '		;FILENAME FOR INPUT
13600		'MUS   '			;EXTENSION
13700		0			;INFORMATION ON FILE
13800		0			;PROJECT PROG#
13900	
14000	FILBL2: 'MUSAA '		;FILENAME FOR INPUT, 2ND CHOICE
14100		'DMD   '			;EXTENSION
14200		0			;INFORMATION ON FILE
14300		0			;PROJECT PROG#
14400	
14500	CLIST:	IOWD	1,NWD		;FOR THE FIRST RECORD
14600		0
14700	
14800	INLIST:	0			;WILL CONTAIN AN IOWD
14900		0
15000	
15100	OUTWC:	0			;WILL CONTAIN AN IOWD FOR D-A
15200		3650			;MAGIC BITS FOR 136.
15300	OUTBIT: 4000			;BITS FOR D-A
15400		BLOCK	2
15500	
15600	begin magdsk
15700	
15800	A←1
15900	B←2
16000	D←3
16100	OLNG←=2432	;size of mag tape records. must be multiple of =128.
16200	
16300	ILNG←=2432
16400	ichn←adchn
16500	ochn←dskchn
16600	↑START:	CALLI 0
16700		INIT ICHN,3B28+17
16800		SIXBIT /MTA0/
16900		0
17000		HALT
17100		MTAPE ICHN,1	;REWIND THE TAPE
17200		JFCL
17300		INIT OCHN,17
17400		SIXBIT /DSK/
17500		0
17600		HALT
17700		ENTER OCHN,[SIXBIT /MUSIC/
17800	                    SIXBIT /MUS/
17900		            0
18000		            0]
18100		HALT
18200		loop:input ichn,olst
18300			statz ichn,20000
18400			jrst out	;end of tape.
18500			output ochn,olst
18600			jrst loop
18700	OLST:	IOWD OLNG,OBUF
18800		0
18900	obuf←← buf1
19000		bend magdsk
19100	
19200	end beg
20000	ENTRY CORGET,CORREL,FSINIT
20010	TITLE CORGET
20020	INTERNAL FSINIT,CORGET,CORREL
20030	EXTERNAL JOBREL,JOBSA,JOBFF,JOBDDT,JOBSYM
20040	
20050	THIS←2
20060	SIZ←3
20070	NEXT←4
20080	PREV←5
20090	LAST←6
20100	USER←7
20110	TEMP←10
20120	P←17
20130	
20140	INTEGER TOP,FRELST,LOWC
20150	TRIVIAL←←5
20160	ARRAY BUFACS[20]
20170	
20180	DEFINE TERPRI(A) <
20190		PUSHJ P,[
20200			OUTSTR [ASCIZ /A
20210	/]
20220			JRST 4,CPOPJ]
20230	>
20240	
20250	DEFINE ERR(A) <
20260		OUTSTR [ASCIZ /A
20270	/]
20280	>
21000	; UTILITY ROUTINES. SAVE AND GET ACCUMULATORS
21010	
21020	FSINIT:	MOVEI	TEMP,-1		;FOR MAX CORE 
21030		MOVEM	TEMP,JOBFF	; IS DOING
21040		HLRZ	USER,JOBSA
21050		SKIPN	JOBDDT		;IF DDT IS IN CORE,
21060		 JRST	 NODDT		; MAKE SURE ITS SYMBOLS ARE PROTECTED
21070		HRRZ	TEMP,JOBSYM	;IF JOBSYM IS BELOW JOBFF, THEN 
21080		CAML	TEMP,USER	; ASSUME ALL SYMBOLS ARE BELOW.
21090		 TERPRI	 <YOUR SYMBOLS ARE SOON TO BE OBLITERATED>
21100	
21110	
21120	NODDT:	SETZM	FRELST		; CLEAR POINTERS
21130		SETZM	TOP
21140		MOVEI	THIS,(USER)
21150		MOVEM	THIS,LOWC	; SET BOTTOM OF CORE
21160		PUSHJ	P,NEWBLK	;MAKE NEW AREA INTO A FREE BLOCK
21170		JRST	JUSTSAVE	;SAVE ACS
21180	
21190	NEWBLK:	
21200		HRRZ	LAST,JOBREL	;END OF BIG BLOCK
21210	NEWB1:	SETZM	(THIS)		;POINTERS WORD IN BIG BLOCK
21220		ADDI	LAST,1		;CONFORM TO "LAST" STANDARDS
21230		MOVEM	LAST,TOP	;TOP OF FREE SPACE
21240		PUSH	P,SIZ		;SAVE SIZE
21250		MOVE	SIZ,LAST	;COMPUTE SIZE OF NEW BLOCK
21260		SUB	SIZ,THIS	;SIZE OF BIG BLOCK
21270		PUSHJ	P,RELINK	;PUT ON FREE STORAGE LIST
21280		POP	P,SIZ		;GET SIZ BACK
21290	CPOPJ:	POPJ	P,
21300	
21310	
21320	JUSTSAVE:
21330		MOVEM	TEMP,BUFACS+TEMP
21340		MOVEI	TEMP,BUFACS
21350		BLT	TEMP,BUFACS+LAST
21360		POPJ	P,
21370	
21380	BUFRST:	MOVSI	TEMP,BUFACS
21390		BLT	TEMP,TEMP
21400		POPJ	P,
23000	; ROUTINES TO LINK AND UNLINK A BLOCK INTO THE FREE LIST
23010	; CALL WITH ADDRESS IN THIS AND SIZE IN SIZ
23020	
23030	UNLINK:	
23040		HRRZ	NEXT,(THIS)	;→NEXT BLOCK
23050		HLRZ	PREV,(THIS)	;→PREVIOUS BLOCK
23060		SKIPN	PREV		;IF A PREV BLOCK DOES NOT EXIST,
23070		 MOVEI	 PREV,FRELST	; USE FRELST POINTER
23080		HRRM	NEXT,(PREV)	;CHANGE ITS NEXT FIELD
23090		SKIPE	NEXT		;IF A NEXT BLOCK EXISTS,
23100		 HRLM	 PREV,(NEXT)	; CHANGE ITS PREV FIELD
23110		POPJ	P,		;BLOCK IN "THIS" IS NO LONGER ON FRELST
23120	
23130	RELINK:
23140		HRRZM	THIS,-1(LAST)	;X-BIT ← 0, RH ← PTR TO HEAD
23150		MOVEM	SIZ,1(THIS)	;GREATER 0 SIZE FIELD ⊃ FREE BLOCK
23160		SKIPE	NEXT,FRELST	;PLACE NEW BLOCK ON FRONT OF FRELST
23170		 HRLM	 THIS,(NEXT)	; IF THERE IS ONE
23180		HRRZM	NEXT,(THIS)	;POINT TO NEXT FROM THIS
23190		HRRZM	THIS,FRELST	;UPDATE FRELST POINTER
23200		POPJ	P,		;RETURN
25000	; ROUTINE TO GET CORE
25010	; CALL WITH SIZE IN AC 3
25020	; RETURNS BLOCK IN 2
25030	; SAVES ALL ACCUMULATORS
25040	
25050	CORGET:
25060		PUSHJ	P,JUSTSAV	;SAVE AC'S, INITIALIZE WORLD PERHAPS
25070	
25080	
25090	COR21:	ADDI	SIZ,3		;3 WORDS FOR CONTROL INFO
25100		MOVEI	THIS,FRELST	;THIS WILL POINT TO THE FIRST GOOD BLOCK
25110	
25120	GETLUP:	HRRZ	THIS,(THIS)	;→NEXT FREE BLOCK
25130		JUMPE	THIS,EXPAND	;TRY TO EXPAND CORE, NONE EXIST YET
25140		CAMLE	SIZ,1(THIS)	;WILL IT FIT?
25150		 JRST	 GETLUP		; NO, TRY NEXT
25160	
25170	GETCOR:	AOS	(P)		;SUCCESS GUARANTEED
25180		HRRZM	THIS,BUFACS+THIS ;RESULT(ALMOST)
25190		PUSHJ	P,UNLINK	;UNLINK THIS BLOCK
25200		MOVE	LAST,1(THIS)	;REAL BLOCK SIZE
25210		CAIGE	LAST,TRIVIAL(SIZ) ;IS DIFFERENCE NEGLIGIBLE?
25220		 JRST	 [MOVSI TEMP,400000 ;YES, USE WHOLE THING --
25230			  ADD   LAST,THIS ; MARK X-BIT TO INDICATE IN USE
25240			  HLLM	TEMP,-1(LAST)
25250			  JRST	GETOUT]	;AND GO FINISH OUT
25260	
25270		MOVEM	SIZ,1(THIS)	;NEW SIZE FOR RESULT
25280		HRRZ	TEMP,THIS	;SAVE START OF BLOCK (RESULT)
25290		ADD	THIS,SIZ	;NEW START FOR REMAINING FREE STUFF
25300		SUB	LAST,SIZ	;NEW SIZE FOR REMAINS
25310		MOVE	SIZ,LAST
25320		ADD	LAST,THIS	;NEW END FOR REMAINS
25330		HRLI	TEMP,400000	;TURN X-BIT ON
25340		MOVEM	TEMP,-1(THIS)	;IN USER'S BRAND NEW BLOCK
25350		PUSHJ	P,RELINK	;RELINK REMAINS, RESTORE ACS
25360	
25370	
25380	GETOUT:	PUSHJ	P,BUFRST	;RESTORE ACS
25390		SETZM	(THIS)		;PTR RETRIEVED FROM STORAGE
25400		MOVNS	1(THIS)		;SIZE NEG ⊃ IN USE
25410		ADDI	THIS,2		;USER DOESN'T SEE THIS HEADER
25420		POPJ	P,		;HERE'S YOUR BLOCK!
27000	; HERE WE INCREASE THE JOB CORE SIZE
27010	
27020	EXPAND:	PUSH	P,SIZ		;SAVE TOTAL SIZE
27030		HRRZ	THIS,TOP	;THIS→NEW BLOCK IF NEXT LOWER IS USED
27040		SKIPGE	-1(THIS)	;IS TOP BLOCK FREE?
27050		 JRST	 GETMOR		; NO, USE WHAT YOU HAVE
27060		HRRZ	THIS,-1(THIS)	;UNLINK THE
27070		PUSHJ	P,UNLINK	; TOP BLOCK
27080	
27090	GETMOR:	MOVE	TEMP,THIS
27100		ADDI	TEMP,=1024(SIZ)	;GET MORE AND THEN SOME
27110		POP	P,SIZ		;GET THIS BACK BEFORE YOU FORGET
27120		CALL	TEMP,[SIXBIT /CORE/]	;ASK FOR MORE
27130		 JRST	 BUFRST		;CAN'T GET IT
27140		PUSHJ	P,NEWBLK	;MAKE TOP LOOK LIKE FREE BLOCK
27150		CAMLE	SIZ,1(THIS)	;NOW SHOULD FIT
27160		 ERR	 <DRYROT -- EXPAND CODE GLUBBED UP>
27170		JRST	GETCOR
28000	; ROUTINE TO RELEASE CORE, ENTER WITH BLOCK ADDRESS IN 2
28010	
28020	CORREL:
28030		PUSHJ	P,JUSTSAVE	;SAVE ACS
28040	
28050	; MERGE WITH LOWER NEIGHBOR (ADDRESS-WISE) IF POSSIBLE
28060	
28070		SUBI	THIS,2		;USER THINKS IT STARTED 2 PAST
28080		MOVN	SIZ,1(THIS)	;SIZE OF THIS BLOCK
28090		MOVE	LAST,SIZ	;ADDRESS OF UPPER
28100		ADD	LAST,THIS	;  NEIGHBOR
28110	
28120		CAMGE	THIS,LOWC	;IS ADDRESS IN RANGE?
28130		 ERR	 <DRYROT -- BAD ADDRESS TO BUFREL>
28140		CAME	THIS,LOWC	;CAN THERE BE A LOWER BLOCK
28150		SKIPGE	-1(THIS)	; AND IF SO, IS IT FREE?
28160		 JRST	 UPPET		; NO, LOOK FOR UPPER BLOCK
28170	
28180		HRRZ	THIS,-1(THIS)	;→LOWER BLOCK
28190		PUSHJ	P,UNLINK	;UNLINK IT FROM LIST
28200		ADD	SIZ,1(THIS)	;INCREASE SIZE
28210		
28220	; MERGE WITH UPPER NEIGHBOR IF POSSIBLE
28230	
28240	UPPET:	CAMLE	LAST,TOP
28250		 ERR	 <YOU ARE ABOUT TO GET AN ILL MEM-REF>
28260	
28270		CAME	LAST,TOP	;IS THERE AN UPPER BLOCK?
28280		SKIPGE	1(LAST)		;AND IF SO, IS IT FREE?
28290		 JRST	 LNKRET		; NO, RELINK AND GO AWAY
28300	
28310	UPPR:	PUSH	P,THIS
28320		HRRZ	THIS,LAST	;THIS → UPPER NEIGHBOR
28330		PUSHJ	P,UNLINK	;GET IT OUT
28340		ADD	LAST,1(THIS)	; INCREASE EXTENT
28350		ADD	SIZ,1(THIS)	; AND TOTAL SIZE
28360		POP	P,THIS		; GET HEADER POINTER BACK
29000	; HERE WE TRY TO SHRINK CORE
29010	
29020	LNKRET:	
29030		CAMG	LAST,JOBREL	;THIS IS THE LAST CORE BLOCK, AND
29040		 JRST	 LNKRT
29050		CAIGE	SIZ,=2046	; IT IS MORE THAN 2K LONG,
29060		 JRST	 LNKRT
29070		MOVEI	TEMP,=2046(THIS) ;THEN 1) SHRINK CORE TO 2K FOR LAST BLOCK
29080		CALL	TEMP,[SIXBIT /CORE/]
29090		 ERR	 <DRYROT --CORSER&LNKRET>
29100		MOVE	LAST,JOBREL	; AND  2) ADJUST BLOCK TO INDICATE
29110		ADDI	LAST,1
29120		MOVEM	LAST,TOP	;AND RECORD NEW RESULTS.
29130		MOVE	SIZ,LAST	;THE CHANGE BEFORE RELINKING
29140		SUB	SIZ,THIS
29150	LNKRT:
29160		PUSHJ	P,RELINK	;PUT IT BACK
29170		JRST	BUFRST		;AND GO AWAY
29180	
29190	END